library(tidyverse)
library(tidycensus)
library(lubridate)
library(DT)
library(knitr)
library(viridis)

knitr::opts_chunk$set(warning = FALSE)
knitr::opts_chunk$set(message = FALSE)
knitr::opts_chunk$set(fig.width = 8)
knitr::opts_chunk$set(fig.height = 3)

# load up cleaned up data
mega_df <- readRDS("../../data/clean/mega_df_pt2.RDS") %>%
  mutate(declaration_year=year(declarationDate)) %>% 
  #filter(declaration_year>2010) %>%
  filter(programArea=="HMGP")

# import county census data (poverty, urban, race)
county_data <- read_csv("../../data/clean/county_combined.csv")
# import county names (whoops)
county_names <- read_csv("../../data/clean/county_names.csv")

county_data <- county_data %>% left_join(county_names)

# summarize data by county
counties_only <- mega_df %>%
  filter(programArea=="HMGP") %>%
  filter(programFy>=2010) %>%
  filter(status!="Obligated") %>%
  mutate(fipsStateCode=case_when(
    nchar(stateNumberCode)==1 ~ paste0("0", stateNumberCode),
    TRUE ~ as.character(stateNumberCode)
  )) %>%
  mutate(months_closed=case_when(
    months_closed < 0 ~ 0,
    TRUE ~ months_closed
  )) %>% 
  mutate(fipsCountyCode=case_when(
    nchar(countyCode)==1 ~ paste0("00", countyCode),
    nchar(countyCode)==2 ~ paste0("0", countyCode),
    is.na(countyCode) ~ "000",
    TRUE ~ as.character(countyCode)
  )) %>%
  mutate(GEOID=paste0(fipsStateCode, fipsCountyCode)) %>%
  group_by(GEOID, status) %>%
  summarize(projects=n(),
            funding=sum(projectAmount),
            federal_funding=sum(federalShareObligated),
            average_months_approval=mean(months_approval_year, na.rm=T),
            average_months_closed=mean(months_closed, na.rm=T)) %>%
  group_by(GEOID) %>%
  mutate(percent_projects=round(projects/sum(projects, na.rm=T)*100,1),
         percent_funding=round(funding/sum(funding, na.rm=T)*100,1)) %>%
  left_join(county_data)


# 1. What percent of money is unspent
share1 <- mega_df %>%
    filter(programFy>=2010) %>%
   group_by(status) %>%
   summarize(spent=sum(projectAmount, na.rm=T)) %>%
   mutate(percent_money=round(spent/sum(spent, na.rm=T)*100,1))


# 2. What percent of projects are still open
open_closed <- mega_df %>%
   filter(programFy>=2010) %>%
  group_by(status) %>%
  summarize(total=n()) %>%
  mutate(percent_projects=round(total/sum(total, na.rm=T)*100,1))

#share1 <- mega_df %>%
#  group_by(status) %>%
#  summarize(spent=sum(federalShareObligated, na.rm=T)) %>%
#  mutate(percent_money=round(spent/sum(spent, na.rm=T)*100,1))

# 3. What's the average wait time to approve projects after a disaster?
timing_approval <- mega_df %>%
  #group_by(status) %>%
  summarize(months_approval=round(mean(months_approval, na.rm=T),1))

# 4. What's the average time between approval and close?
timing_closed <- mega_df %>%
  #group_by(status) %>%
  summarize(months_closed=round(mean(months_closed, na.rm=T),1))


# 5. What's the average time between disaster and close?
months_closed <- mega_df %>%
  mutate(interval_disaster_closed=interval(declarationDate, dateClosed)) %>%
  mutate(months_disaster_closed=interval_disaster_closed %/% months(1)) %>%
  summarize(months_approval_closed=round(mean(months_disaster_closed, na.rm=T),1))

months_closed <- mega_df %>%
  mutate(interval_disaster_closed=interval(declarationDate, dateClosed)) %>%
  mutate(months_disaster_closed=interval_disaster_closed %/% months(1)) %>%
#  mutate(closed_year=year(dateClosed)) %>% 
#  group_by(closed_year) %>% 
  summarize(months_approval_closed=round(mean(months_disaster_closed, na.rm=T),1))

There have been 23,039 hazard mitigation projects opened by FEMA since 2010.

There are still 4,797 still open, which is about 20.8% of all projects.

However, $9,441,694,461 hasn’t been closed out. That’s about 82.4% hazard mitigation project money unspent.

Since 2010, only $2,018,862,029 has been spent.

It takes, on average, about 25.7 months between a declared disaster and a mitigation project to be approved by FEMA.

After a project is approved by FEMA, it takes an average of 40.5 months to close out a project after it’s been approved. Nearly twice as long to close as it takes to approve.

Overall, after a declared disaster it takes an average of 5.6 years for a project meant to prepare for and alleviate the damages for future disasters to be fully funded and closed out.

That’s a lot of time to pass.

Projects approved annually

There have been more projects approved this year than ever before. More than two and a half times the number of hazard mitigation projects have been approved so far this year than in all of 2012.

Chart

mega_df %>%
  mutate(approved_year=year(dateApproved)) %>%
  count(approved_year) %>% 
  filter(approved_year>2010) %>% 
  ggplot(aes(x=approved_year, y=n)) +
  geom_col() +
  scale_y_continuous(labels = scales::comma) +
  labs(title="Hazard Mitigation Grants approved over time",
       caption="Data: FEMA",
       y="Approved",
       x="") +
  theme_minimal()

Table

mega_df %>%
  mutate(approved_year=year(dateApproved)) %>%
  count(approved_year) %>% 
  filter(approved_year>2010) %>% 
  datatable(extensions = c("Buttons"),
            options = list(dom = 'Bfrtip',
                           buttons = list(list(extend = "csv", 
                                               text = "Download Table", 
                                               filename = "approvals_annual",              exportOptions = list(modifier = list(page = "all"))))))

Dollars approved for projects annually

Project costs approved have grown exponentially– up 876% over 10 years.

Chart

mega_df %>%
  mutate(approved_year=year(dateApproved)) %>%
  group_by(approved_year) %>%
  summarize(sum=sum(projectAmount, na.rm=T)) %>% 
  filter(approved_year>2010) %>% 
  ggplot(aes(x=approved_year, y=sum)) +
  geom_col() +
  scale_y_continuous(labels = scales::comma) +
  labs(title="Hazard Mitigation Grant money approved over time",
       caption="Data: FEMA",
       y="Approved sum",
       x="") +
  theme_minimal()

Table

mega_df %>%
  mutate(approved_year=year(dateApproved)) %>%
  group_by(approved_year) %>%
  summarize(sum=sum(projectAmount, na.rm=T)) %>% 
  filter(approved_year>2010) %>% 
  datatable(extensions = c("Buttons"),
            options = list(dom = 'Bfrtip',
                           buttons = list(list(extend = "csv", 
                                               text = "Download Table", 
                                               filename = "approval_sums_annual",              exportOptions = list(modifier = list(page = "all"))))))

Disasters that lead to approved mitigation projects

FEMA’s data only includes projects that have been approved. Only one project from a disaster in 2021 has been approved this year. There is a lag in approval.

Chart

mega_df %>%
  mutate(declaration_year=year(declarationDate)) %>%
  filter(declaration_year>2010) %>% 
  group_by(declaration_year) %>%
  summarize(total=n(),
            months_approval=round(mean(months_approval, na.rm=T),1)) %>% 
  ggplot(aes(x=declaration_year, y=total)) +
  geom_col() +
  scale_y_continuous(labels = scales::comma) +
  labs(title="Hazard Mitigation Projects approved by disaster year",
       caption="Data: FEMA",
       y="Approved projects",
       x="") +
  theme_minimal()

Table

mega_df %>%
  mutate(declaration_year=year(declarationDate)) %>%
  filter(declaration_year>2010) %>% 
  group_by(declaration_year) %>%
  summarize(total=n(),
            months_approval=round(mean(months_approval, na.rm=T),1)) %>% 
  datatable(extensions = c("Buttons"),
            options = list(dom = 'Bfrtip',
                           buttons = list(list(extend = "csv", 
                                               text = "Download Table", 
                                               filename = "disasters_approved_table",              exportOptions = list(modifier = list(page = "all"))))))

Time to approve projects

Most of the time, there is an open period to apply for project funding that lasts about a year after a declared disaster, though sometimes that’s extended by 3 to 6 months.

Chart

mega_df %>%
  #mutate(year_approved=year(dateApproved)) %>% 
  mutate(year_disaster=year(declarationDate)) %>% 
  mutate(disaster_approval_interval=interval(declarationDate, dateApproved)) %>% 
  mutate(months_disaster_approved=disaster_approval_interval %/% months(1)) %>% 
  mutate(months_disaster_approved=case_when(
    months_disaster_approved < 0 ~ 0,
    TRUE ~ months_disaster_approved
  )) %>% 
  group_by(year_disaster) %>%
  #filter(initially_approved_year>2010) %>% 
  summarize(total=n(),
            months_disaster_approved=round(mean(months_disaster_approved, na.rm=T),1)) %>% 
  mutate(years=months_disaster_approved/12) %>% 
  filter(year_disaster>2010) %>% 
  ggplot(aes(x=year_disaster, y=years)) +
  
  geom_bar(position="stack", stat="identity") +
  #facet_wrap(~still_open) +
  scale_y_continuous(labels = scales::comma) +
  labs(title="Years it took for projects to get approved",
       subtitle="By project approval year",
       caption="Data: FEMA",
       y="Years",
       x="") +
  theme_minimal()

Table

mega_df %>%
  mutate(year_closed=year(dateClosed)) %>% 
  mutate(disaster_closed_interval=interval(declarationDate, dateApproved)) %>% 
  mutate(months_disaster_closed=disaster_closed_interval %/% months(1)) %>% 
  mutate(months_disaster_closed=case_when(
    months_disaster_closed < 0 ~ 0,
    TRUE ~ months_disaster_closed
  )) %>% 
  group_by(year_closed) %>%
  #filter(initially_approved_year>2010) %>% 
  summarize(total=n(),
            months_disaster_closed=round(mean(months_disaster_closed, na.rm=T),1)) %>% 
  mutate(years=months_disaster_closed/12) %>% 
  filter(year_closed>2010) %>% 
  datatable(extensions = c("Buttons"),
            options = list(dom = 'Bfrtip',
                           buttons = list(list(extend = "csv", 
                                               text = "Download Table", 
                                               filename = "disasters_closed_annually_table",              exportOptions = list(modifier = list(page = "all"))))))

Time to close projects

Projects that closed in 2020 took an average of 7 years to get funded and completed, one year longer than it took a decade ago. (two years longer than two decades ago).

Chart

mega_df %>%
  mutate(year_closed=year(dateClosed)) %>% 
  mutate(disaster_closed_interval=interval(declarationDate, dateClosed)) %>% 
  mutate(months_disaster_closed=disaster_closed_interval %/% months(1)) %>% 
  mutate(months_disaster_closed=case_when(
    months_disaster_closed < 0 ~ 0,
    TRUE ~ months_disaster_closed
  )) %>% 
  group_by(year_closed) %>%
  #filter(initially_approved_year>2010) %>% 
  summarize(total=n(),
            months_disaster_closed=round(mean(months_disaster_closed, na.rm=T),1)) %>% 
  mutate(years=months_disaster_closed/12) %>% 
  filter(year_closed>2010) %>% 
  ggplot(aes(x=year_closed, y=years)) +
  
  geom_bar(position="stack", stat="identity") +
  #facet_wrap(~still_open) +
  scale_y_continuous(labels = scales::comma) +
  labs(title="Years it took for projects to close",
       subtitle="By project close year",
       caption="Data: FEMA",
       y="Years",
       x="") +
  theme_minimal()

Table

mega_df %>%
  mutate(year_closed=year(dateClosed)) %>% 
  mutate(disaster_closed_interval=interval(declarationDate, dateClosed)) %>% 
  mutate(months_disaster_closed=disaster_closed_interval %/% months(1)) %>% 
  mutate(months_disaster_closed=case_when(
    months_disaster_closed < 0 ~ 0,
    TRUE ~ months_disaster_closed
  )) %>% 
  group_by(year_closed) %>%
  #filter(initially_approved_year>2010) %>% 
  summarize(total=n(),
            months_disaster_closed=round(mean(months_disaster_closed, na.rm=T),1)) %>% 
  mutate(years=months_disaster_closed/12) %>% 
  filter(year_closed>2010) %>% 
  datatable(extensions = c("Buttons"),
            options = list(dom = 'Bfrtip',
                           buttons = list(list(extend = "csv", 
                                               text = "Download Table", 
                                               filename = "disasters_closed_annually_table",              exportOptions = list(modifier = list(page = "all"))))))

Backlog of projects

Chart

mega_df %>%
  mutate(initially_approved_year=year(dateApproved)) %>%
  mutate(status = case_when(
    is.na(dateClosed) ~ "Still Open",
    TRUE ~ "Closed"
  )) %>% 
  mutate(dateClosed=case_when(
    is.na(dateClosed) ~ mdy_hms("10-01-2021 00:00:00"),
    TRUE ~ dateClosed
  )) %>% 
  mutate(initially_approved_closed_interval=interval(dateApproved, dateClosed)) %>% 
  mutate(months_initially_approved_closed=initially_approved_closed_interval %/% months(1)) %>% 
  mutate(months_initially_approved_closed=case_when(
    months_initially_approved_closed < 0 ~ 0,
    TRUE ~ months_initially_approved_closed
  )) %>% 
  group_by(initially_approved_year, status) %>%
  filter(initially_approved_year>2010) %>% 

  summarize(total=n(),
            months_initially_approved_closed=round(mean(months_initially_approved_closed, na.rm=T),1)) %>% 
  ggplot(aes(x=initially_approved_year, y=total, fill=status)) +
  
  geom_bar(position="stack", stat="identity") +
  #facet_wrap(~still_open) +
  scale_y_continuous(labels = scales::comma) +
  labs(title="Share of Hazard Mitigation Projects still waiting to be closed out",
       subtitle="By approval year",
       caption="Data: FEMA",
       y="Projects",
       x="") +
  theme_minimal()

mega_df %>%
  mutate(initially_approved_year=year(dateApproved)) %>%
  mutate(status = case_when(
    is.na(dateClosed) ~ "Still Open",
    TRUE ~ "Closed"
  )) %>% 
  mutate(dateClosed=case_when(
    is.na(dateClosed) ~ mdy_hms("10-01-2021 00:00:00"),
    TRUE ~ dateClosed
  )) %>% 
  mutate(initially_approved_closed_interval=interval(dateApproved, dateClosed)) %>% 
  mutate(months_initially_approved_closed=initially_approved_closed_interval %/% months(1)) %>% 
  mutate(months_initially_approved_closed=case_when(
    months_initially_approved_closed < 0 ~ 0,
    TRUE ~ months_initially_approved_closed
  )) %>% 
  group_by(initially_approved_year) %>%
  filter(initially_approved_year>2010) %>% 

  summarize(total=n(),
            months_initially_approved_closed=round(mean(months_initially_approved_closed, na.rm=T),1)) %>% 
  ggplot(aes(x=initially_approved_year, y=months_initially_approved_closed)) +
  
  geom_bar(stat="identity") +
  #facet_wrap(~still_open) +
  scale_y_continuous(labels = scales::comma) +
  labs(title="Average number of months a project has been waiting to be closed out",
       caption="Data: FEMA",
       y="Months",
       x="") +
  theme_minimal()
mega_df %>%
  mutate(initially_approved_year=year(declarationDate)) %>%
  mutate(status = case_when(
    is.na(dateClosed) ~ "Still Open",
    TRUE ~ "Closed"
  )) %>% 
  mutate(dateClosed=case_when(
    is.na(dateClosed) ~ mdy_hms("10-01-2021 00:00:00"),
    TRUE ~ dateClosed
  )) %>% 
  mutate(initially_approved_closed_interval=interval(declarationDate, dateClosed)) %>% 
  mutate(months_initially_approved_closed=initially_approved_closed_interval %/% months(1)) %>% 
  mutate(months_initially_approved_closed=case_when(
    months_initially_approved_closed < 0 ~ 0,
    TRUE ~ months_initially_approved_closed
  )) %>% 
  group_by(initially_approved_year, status) %>%
  filter(initially_approved_year>2010) %>% 

  summarize(total=n(),
            months_initially_approved_closed=round(mean(months_initially_approved_closed, na.rm=T),1)) %>% 
  ggplot(aes(x=initially_approved_year, y=total, fill=status)) +
  
  geom_bar(position="stack", stat="identity") +
  #facet_wrap(~still_open) +
  scale_y_continuous(labels = scales::comma) +
  labs(title="Share of Hazard Mitigation Projects still waiting to be closed out",
       subtitle="By disaster declaration year",
       caption="Data: FEMA",
       y="Months",
       x="") +
  theme_minimal()

Table

mega_df %>%
  mutate(approved_year=year(dateApproved)) %>%
  group_by(approved_year) %>%
  filter(approved_year>2010) %>% 
  summarize(total=n(),
            months_closed=round(mean(months_closed, na.rm=T),1))  %>% 
  datatable(extensions = c("Buttons"),
            options = list(dom = 'Bfrtip',
                           buttons = list(list(extend = "csv", 
                                               text = "Download Table", 
                                               filename = "disasters_closed_approved_table",              exportOptions = list(modifier = list(page = "all"))))))

Percent of money unspent by county poverty percentiles

In richer communities, half of hazard mitigation money has been spent. In poorer communities, only a third has been spent.

The poorer the county (4 in the quantile), the higher the rate of unspent money. NA represents money to the state and not a county.

mega_df %>%
  select(-majority) %>%
  left_join(county_data) %>%
  mutate(pov_quantile= ntile(pctpov, 4)) %>%
  group_by(status, pov_quantile) %>%
  summarize(spent=sum(projectAmount, na.rm=T)) %>%
  group_by(pov_quantile) %>% 
  mutate(percent_money=round(spent/sum(spent, na.rm=T)*100,1)) %>% 
  filter(status=="Closed") %>% 
  kable(format.args = list(big.mark = ","))
status pov_quantile spent percent_money
Closed 1 2,081,832,006 49.6
Closed 2 1,962,924,946 48.9
Closed 3 3,232,155,361 57.4
Closed 4 1,526,342,595 35.3
Closed NA 1,355,873,367 31.3

Counties getting no Hazard Mitigation Project money

18 percent of rural communities that fell in a disaster declared zone aren’t even getting any Hazard Mitigation Project money.

no_mitigation <- readRDS("../../data/clean/no_mitigtation.RDS")
county_data_none <- county_data %>%
  mutate(pov_quantile= ntile(pctpov, 4)) %>%
  filter(GEOID %in% no_mitigation)

total_ur <- county_data %>% 
  count(urban_rural, name="total_counties")

county_data_none %>%
  count(urban_rural) %>% 
  left_join(total_ur) %>% 
  mutate(percent=round(n/total_counties*100,1)) %>% 
  rename(counties_with_no_projects=n,
         counties=total_counties) %>% 
  kable()
urban_rural counties_with_no_projects counties percent
1 1 68 1.5
2 42 368 11.4
3 24 372 6.5
4 28 358 7.8
5 67 641 10.5
6 235 1335 17.6
NA 19 78 24.4 
# 1 - 2: 10%
# 3 - 4: 7%
# 5 - 6: 15%

County level project status and funding

counties_only %>%
  select(NAME, status, projects, funding, `federal funding`=federal_funding,
         `average months approval`=average_months_approval,
         `average months closed`=average_months_closed,
         `percent projects`=percent_projects,
         `percent funding`=percent_funding 
         ) %>% 
  filter(!is.na(NAME)) %>% 
  mutate(`average months approval`=round(`average months approval`,1),
         `average months closed`=round(`average months closed`,1)) %>% 

  datatable(extensions = c("Buttons"),
            options = list(dom = 'Bfrtip',
                           buttons = list(list(extend = "csv", 
                                               text = "Download Table", 
                                               filename = "county_data",              exportOptions = list(modifier = list(page = "all"))))))

Projects closed county map

county_map <- get_acs(geography = "county",
                      variables = "B03002_001",
                      survey="acs5",
                      year=2019,
                      geometry=T,
                      shift_geo=T)

counties_closed_map <- counties_only %>% 
  filter(status=="Closed") %>% 
  right_join(county_map)

ggplot(counties_closed_map) +
  #geom_sf(aes(fill=percent_projects, geometry=geometry), color="white", width=.1) +
  geom_sf(aes(fill=percent_projects, geometry=geometry), color=NA) +
  theme_void() +
  scale_fill_viridis(direction=-1) +
  #scale_fill_manual(values = c("grey", "purple")) +
  theme(panel.grid.major = element_line(colour = 'transparent')) +
  labs(title="Percent of Hazard Mitigation Projects closed",
       #subtitle="During the months of June through August",
       caption="Data: FEMA")

Projects funding county map

ggplot(counties_closed_map) +
  #geom_sf(aes(fill=percent_funding, geometry=geometry), color="white", width=.1) +
  geom_sf(aes(fill=percent_funding, geometry=geometry), color=NA) +
  theme_void() +
  scale_fill_viridis(direction=-1, option = "A") +
  #scale_fill_manual(values = c("grey", "purple")) +
  theme(panel.grid.major = element_line(colour = 'transparent')) +
  labs(title="Percent of Hazard Mitigation Projects funded",
       #subtitle="During the months of June through August",
       caption="Data: FEMA")

Projects closed timing county map

write_csv(counties_closed_map, "../../outputs/graphics/counties_closed_map.csv", na="")

ggplot(counties_closed_map) +
  #geom_sf(aes(fill=average_months_closed, geometry=geometry), color="white", width=.1) +
  geom_sf(aes(fill=average_months_closed, geometry=geometry), color=NA) +
  theme_void() +
  scale_fill_viridis(direction=-1, option = "B") +
  #scale_fill_manual(values = c("grey", "purple")) +
  theme(panel.grid.major = element_line(colour = 'transparent')) +
  labs(title="Average months to close a Hazard Mitigation Project",
       #subtitle="During the months of June through August",
       caption="Data: FEMA")